Durante el periodo entre 2014 y 2018 se logró tomar una cantidad significativa de datos sobre la accidentalidad en Medellín y algunas de sus zonas aledañas, para evidenciar así, el problema de movilidad que presenta el área. Estos datos se encuentran en el portal geomed, donde cada uno de estos incidentes se encuentra georreferenciado, dividido por barrio y comuna. Cuenta, además, con la información sobre la vía donde el accidente ocurrió y también sobre el tipo de accidente que se dio, la fecha de éste e incluso los daños perjudiciales causados a los ciudadanos -muertos, heridos o solo daños materiales-.
Ahora bien, al tener más de 200.000 datos durante este intervalo, el equipo se planteó el objetivo de darle un buen uso a estos, no sólo para analizar lo que sucedió en este lapso, sino también para ayudar a predecir accidentes a futuro y así poder esgrimir una función prevencionista. En ese orden de ideas, para acceder a la información recolectada y al presente análisis se habilitará el siguiente enlace XXXX. En donde la información a la que se accede estará presentada de una forma muy innovadora pues está desarrollada y pensada de forma interactiva e intuitiva, para obtener un mejor entendimiento del usuario.
El análisis y los modelos que se pretenden construir sólo abarcan el área urbana de Medellín correspondiente a sus 16 comunas y sus respectivos barrios.
Construir un sistema que le permita a la Secretaría de Movilidad de Medellín tomar decisiones en la creación de estrategias que ayuden a reducir la accidentalidad en zona específicas de Medellín, observando cuales son los tipos de accidentes más frecuentes en las diferentes comunas y sus barrios.
También se busca que el sistema les permita a todos los ciudadanos que se movilizan en un vehículo tomar precauciones respecto a los accidentes más frecuentes que suceden en lugares específicos.
Lo anterior creando una interfaz amigable para los usuarios y fácil de utilizar.
Construir modelos que predigan el número de accidentes de cada tipo, tomando como entradas una ventana y una resolución temporal específicas, además de una zona espacial que puede ser un barrio o comuna de Medellín.
Elaborar un sistema que agrupe barrios con características similares por los tipos de accidentes (clase) y que tienen lugar en estos.
Crear una interfaz gráfica que le permita al usuario visualizar con mayor comodidad la accidentalidad que hay en Medellín y las predicciones de esta a futuro.
Los datos utilizados se encuentran en las bases de datos de Geomedellín (Portal Geográfico del Municipio de Medellín) y contienen información referente a múltiples accidentes de tránsito, en los que se detalla el tipo de accidente, dónde y cuándo ocurrió. La base de datos utilizada en este trabajo es una unión de las bases de incidentes en 2014, 2015, 2016, 2017 y 2018, se usará este último año para validar los modelos planteados.
La base de datos original cuenta con las siguientes variables:
Se deciden eliminar las variables “X”, “Y”, “X_MAGNAMED” y “Y_MAGNAMED” ya que cumplen la misma función que las variables “LONGITUD” y “LATITUD”. También se elimina la variable “RADICADO” ya que sirve para identificar a un respectivo incidente, al igual que la variable “OBJECTID”. Se elimina la variable “MES_NOMBRE” ya que es redundante el la base de datos, debido a que se encuentra la misma información en la variable “MES”. Además ponerle los nombres a partir de la variable “MES” traería un aumento al coste computacional innecesario. También se decide eliminar las variables “DIRECCION”, “DIRECCION_ENC”, “CBML”, “TIPO_GEOCOD” y “HORA” ya no serán de utilidad en el modelo.
Además se crea otra variable llamada “DIA_FESTIVO”. Para poder analizar el número de accidentes en los días festivos y demás fechas especiales. Por lo tanto, las variables de interés que se usan en este proyecto son las siguientes:
Definido lo anterior, se realiza una limpieza en la base de datos, ya que hay registros u observaciones que están mal escritos o simplemente no deberían estar. A continuación se explican los cambios realizados.
Se decide quitar los acentos a cada una de las variables categóricas debido a que hay valores repetidos los cuales representan el mismo nivel o categoria, pero con acento y sin acento. Un ejemplo de esto es el barrio Berlpín de la comuna Aranjuez, el cual aparece 647 veces con el nombre de “Berlín” y 15 veces con el nombre de “Berlín”. Por lo tanto se decide arreglar este problema.
La variable COMUNA debe tener las comunas urbanas de Medellín y sus corregimientos.
Se sabe que en Medellín hay 16 comunas urbanas y 5 corregimientos, ambos están compuestos por barrios, por lo que la variable debería tener 16 + 5 = 21 niveles. Pero al observar los niveles de la variable “COMUNA” en el conjunto de entrenamiento, se evidencian 84 comunas, por lo cual se decide buscar las razones de esto y tratar de corregirlo.
Comunas: Popular, Santa Cruz, Manrique, Aranjuez, Castilla, Doce de Octubre, Robledo, Villa Hermosa, Buenos Aires, La Candelaria, Laureles-Estadio, La América, San Javier, El Poblado, Guayabal, Belén.
Corregimientos: Corregimiento de San Cristóbal, Corregimiento de San Antonio de Prado, Corregimiento de Santa Elena, Corregimiento de Altavista, Corregimiento de San Sebastián de Palmitas.
Uno de los problemas que se encuentra es que la persona encargada de digitar los datos se confundió entre las variables “COMUNA” y “BARRIO”. Un ejemplo de esto es el barrio Boston que aparece como comuna en 2 observaciones, con su respectiva comuna (La candelaria) en barrio. Así como el ejemplo anterior, hay varios casos. Por lo cual, estas comunas y barrios se ponen en su posición correcta.
Luego de resolver el problema anterior, se encuentra que aún hay comuna que no pertenecen a las 21 mencionadas anteriormente, estas son: “In”, “AU”, “SN”, “0”. Al no encontrar información de estos valores en la página oficial o en internet, se decide reemplazar estos valores con sus respectivos barrios como datos faltantes o NA.
Se detecta que los barrios contienen algunos problemas de espacios, algunos ejemplos son:
Por lo tanto se arregla este problema quitando el espacio que hay entre “No.” y su número correspondiente en los barrios que tienen esta característica. También se eliminan los espacios que hay antes de la primera letra y después de la última letra.
También se reemplaza “Barrios de Jesús” por “Barrio de Jesús”, “Nueva Villa de La Iguana” por “Nueva Villa de la Iguana”, “Santa María de Los Ángeles” por “Santa María de los Ángeles”, “Villa Lilliam” por “Villa Liliam”.
“Caida de Ocupante” se reemplaza por “Caida Ocupante” ya que se consideran equivalentes. También se elimina la observación con CLASE = “Choque y Atropello” ya que solo hay una.
Se eliminan los espacios que hay antes de la primera letra y después de la última letra en todas las observaciones.
En los datos faltantes de la variable DISENO, se decide usar el nombre de “No Registrado” para reemplazarlos.
En la base de datos se tiene la siguiente cantidad de datos faltantes por variable: la variable BARRIO tiene 19957 de datos faltantes, COMUNA tiene 19957 y CLASE tiene 7. Las demás variables no contienen datos faltantes.
Como la variable CLASE solo tiene 7 datos faltantes, se decide eliminar estas observaciones. Por el contrario, como BARRIO y COMUNA presentan una cantidad importante de los datos, se decide realizar una imputación de los mismos.
Primero se decide realizar la imputación en la variable COMUNA, se utiliza un modelo knn (k-Nearest Neighbour) con variable respuesta COMUNA y como predictoras las variables LATITUD y LONGITUD escaladas. Dado que este es un modelo que usa la distancia euclidiana para clasificar observaciones, se piensa que funcionaría bien para clasificar a las comunas teniendo su ubicación en latitud y longitud.
Para ajustar el modelo se usó la función train del paquete caret, usando K-Fold CV con K=10 y el número de vecinos igual a 1, 4, 7, 10, 13, 16 y 19. Se entrenó el modelo usando los años de 2014 a 2017 y se validó con el año 2018. Se usó la precisión de prueba del modelo como función de optimización. Los resultados obtenidos son los siguientes:
| Accuracy | Kappa | AccuracyLower | AccuracyUpper | AccuracyNull | AccuracyPValue |
|---|---|---|---|---|---|
| 0.9985 | 0.9984 | 0.9981 | 0.9989 | 0.2062 | 0 |
Los resultados se consideran buenos y se decide realizar el reemplazo de los valores faltantes de COMUNA por medio de este modelo.
Se decide usar un modelo knn (k-Nearest Neighbour) con variable respuesta BARRIO y como predictoras las variables LATITUD y LONGITUD escaladas y COMUNA.
Dado que habían valores de barrios que están en el año 2018 pero no en los demás, no se pudo hacer uso del paquete caret ya que presentaba un error al entrenar el modelo, por lo que se decide usar la función knn.cv del paquete class, para medir el comportamiento del modelo knn con k = 1 mediante LOOCV, entrenando el modelo con los años de 2014 hasta 2017 y validando el resultado con el año 2018. Se obtiene una precisión de prueba de 0.9975, por lo que se decide usar este modelo para imputar los datos faltantes en BARRIO.
Finalmente se decide usar solo las comunas del área urbana de Medellín y dejar a un lado los corregimientos, es decir, solo se tendrán las 16 comunas mencionadas anteriormente en este reporte.
Tras las modificaciones mencionadas, de las 228693 observaciones originales entre las bases de datos del 2014 al 2018, se utilizarán 204002 observaciones en el análisis y construcción de los modelos. La base de datos luce de esta manera:
df <- read.csv(file = "Base_definitiva.csv", header = T, nrows = 10000,
stringsAsFactors = T)
df$FECHA <- as.Date(df$FECHA)
dfA continuación se encuentra el acceso al código utilizado en todo este proceso
Enlace: https://github.com/vagarciave/Project_x/blob/master/limpieza/Depuracion.Rmd
## [1] "El promedio de accidentes durante el perido 2014-2018 es: 40800.4"
Se Muestra que el promedio de accidentes es de 40800.4 en el periodo de tiempo a analizar, notar que los valores en estos años son muy parecidos, el año que se aleja mas del promedio de accidentes es el 2018.
Los primeros 5 barrios con mas cantidad de accidentes
Estos son los 5 barrios con mas cantidad de accidentes, los cuales se clasifican por la gravedad, que son:“solo daños”,“Herido” y “Muerto”, se identificaron los primeros barrios con mas accidentalidad por año, notar que la gravedad menos concurrente es “Muerto”, aunque la Candelaria es el barrio con mas accidentes por año, tamibien note que Castilla tiene mas accidentes con gravedad de muertes mas alta que la de los demas barrios.
En los accidentes por comuna se evidencia que la comuna “La Candelaria” es la que mas accidentes ha registrado durante los periodos analizados, la de menor cantidad de accidentes es la comuna “Santa Cruz”.
Se define la accidentalidad como el número de accidentes que hay a nivel diario, semanal y mensual, discriminando por tipo de accidente (CLASE) y barrio o comuna donde éste ocurre. Lo anterior debido a que existe una variabilidad notable a nivel de accidentalidad para cada columna y para cada barrio como se observó en el análisis descriptivo.
Dado que el objetivo es predecir la accidentalidad a nivel diario, mensual o semanal, se busca construir modelos que predigan el número de accidentes en cada uno de los rangos temporales es decir se crearán modelos específicos para cada comuna/barrio según la unidad temporal.
Se piensa que los modelos mixtos o modelos jerárquicos pueden representar bien esta definición de accidentalidad, debido a la agrupación que existe al momento de definir la accidentalidad, es decir, existe una agrupación entre comuna y clase; y otra agrupación entre barrio y clase. Por lo que se decide crear estos modelos con la ayuda del paquete lme4 y medir su ajuste. En cada uno de estos casos se crea un modelo que prediga el número de accidentes, por lo que se considera que la accidentalidad puede seguir una distribución Poisson.
Para evaluar los modelos se crean conjuntos de entrenamiento y conjuntos de validación. Los conjuntos de entrenamiento constan de todas las combinaciones posibles de tipos de accidentes según si es comuna o barrio y su unidad de tiempo con los años (periodos) del 2014 al 2017, el conjunto de validación será con el año 2018.
La medida para evaluar el ajuste de los modelos será el error cuadrático medio en las predicciones tanto para los conjuntos de entrenamiento como para los de validación.
\[MSE = \frac{\sum_{i=1}^N (accidentalidad_i - \widehat{accidentalidad_i)^2}}{N}\]
Con la ayuda de R se crea la siguiente función para obtenerlo:
Se usarán los siguientes paquetes para ajustar los modelos
library(lme4) # Paquete para la creación de modelos mixtos poisson
library(tidyverse) # Paquete para la creación de los conjuntos de datosSe debe modificar la base de datos depurada para poder realizar los modelos. Se crean variables de tiempo a nivel diario, semanal y mensual, además de la variable accidentalidad y días festivos.
# Vector con fechas de dias festivos
# Definir dias festivos
festivos <- ymd(c(
#2014
'2014-01-01','2014-01-06','2014-03-24','2014-04-17','2014-04-18', '2014-05-01',
'2014-06-02','2014-06-23','2014-06-30','2014-07-20','2014-08-07', '2014-08-18',
'2014-10-13','2014-11-03','2014-11-17','2014-12-08','2014-12-25',
#2015
'2015-01-01','2015-01-12','2015-03-23','2015-03-29','2015-04-02','2015-04-03',
'2015-04-05','2015-05-01','2015-05-18','2015-06-08','2015-06-15','2015-06-29',
'2015-07-20','2015-08-07', '2015-08-17','2015-10-12','2015-11-02','2015-11-16',
'2015-12-08','2015-12-25',
#2016
'2016-01-01','2016-01-11','2016-03-20','2016-03-21','2016-03-24','2016-03-25',
'2016-03-27','2016-05-01','2016-05-09','2016-05-30','2016-06-06','2016-07-04',
'2016-07-20','2016-08-07', '2016-08-15','2016-10-17','2016-11-07','2016-11-14',
'2016-12-08','2016-12-25',
#2017
'2017-01-01','2017-01-09','2017-03-20','2017-04-09','2017-04-13','2017-04-14',
'2017-04-16','2017-05-01','2017-05-29','2017-06-19','2017-06-26','2017-07-03',
'2017-07-20','2017-08-07', '2017-08-21','2017-10-16','2017-11-06','2017-11-13',
'2017-12-08','2017-12-25',
#2018
'2018-01-01','2018-01-08','2018-03-19','2018-03-25','2018-03-29','2018-03-30',
'2018-04-01','2018-05-01','2018-05-14','2018-06-04','2018-06-11','2018-07-02',
'2018-07-20','2018-08-07', '2018-08-20','2018-10-15','2018-11-05','2018-11-11',
'2018-12-08','2018-12-25',
#2019
'2019-01-01','2019-01-07','2019-03-25','2019-04-18','2019-04-19','2019-05-1',
'2019-06-03','2019-06-24','2019-07-01','2019-07-20','2019-08-07','2019-08-19',
'2019-10-14','2019-11-04','2019-11-11','2019-12-08','2019-12-25',
#2020
'2020-01-01','2020-01-06','2020-03-23','2020-04-9','2020-04-10','2020-05-01',
'2020-05-25','2020-06-15','2020-06-22','2020-06-29','2020-07-20','2020-08-07',
'2020-08-17','2020-10-12','2020-11-02','2020-11-16','2020-12-08','2020-12-25'
))
df <- df %>% select(COMUNA, CLASE, FECHA, PERIODO, MES, DIA_NOMBRE)
df$FECHA <- as.Date(df$FECHA)
# Se agrega la variable TIEMPO y MES_NOMBRE
df$MES_NOMBRE <- paste(df$PERIODO, df$MES, sep="-") %>% as.yearmon("%Y-%m")
# Para obtener la inversa se usaría: zoo::as.Date(df$FECHA, origin="2014-01-01")
df$TIEMPO_DIA <- as.numeric(as.Date(df$FECHA)) - as.numeric(as.Date("2014-01-01")) + 1
# Se crea la variable SEMANA
df <- df %>% mutate(SEMANA = strftime(FECHA, format = "%Y-%V"),
TIEMPO_SEMANA = match(SEMANA, sort(unique(SEMANA))))
# Se crea la variable MES
df <- df %>% mutate(MES = strftime(FECHA, format = "%Y-%m"),
TIEMPO_MES = match(MES, sort(unique(MES))))
# días festivos
df <- df %>% mutate(DIA_FESTIVO = ifelse(ymd(FECHA) %in% festivos,1,0))
# accidentalidad
df <- df %>% mutate(ACCIDENTALIDAD = 1)Para obtener la base datos en la cual se encuentre el número de accidentes para cada evento considerado, se crea una base de datos con todos los eventos posibles con ayuda de la función expand.grid, en la cual se tiene en cuenta todas la combinaciones de comuna, clase (tipo de accidente) y fecha.
fecha_vector <- as.Date(as.Date("2014-01-01"):as.Date("2018-12-31"))
base <- expand.grid(COMUNA = levels(df$COMUNA), CLASE = levels(df$CLASE),
FECHA = fecha_vector)
base <- base %>% mutate(TIEMPO_DIA = as.numeric(FECHA) -
as.numeric(as.Date("2014-01-01")) + 1)
# PERIODO
base <- base %>% mutate(PERIODO = as.numeric(format(FECHA,'%Y')))
# Se crea la variable SEMANA
base <- base %>% mutate(SEMANA = strftime(FECHA, format = "%Y-%V"),
TIEMPO_SEMANA = match(SEMANA, sort(unique(SEMANA))))
# Se crea la variable MES
base <- base %>% mutate(MES = strftime(FECHA, format = "%Y-%m"),
TIEMPO_MES = match(MES, sort(unique(MES))))
# días festivos
base <- base %>% mutate(DIA_FESTIVO = ifelse(ymd(FECHA) %in% festivos,1,0))Luefo se realiza un left join con la base que contiene todos los posibles eventos y la base de datos que contiene la información de los accidentes (base depurada).
base <- left_join(base, subset(df, select = -DIA_NOMBRE),
by = c("COMUNA", "CLASE", "FECHA", "TIEMPO_DIA",
"PERIODO", "SEMANA", "TIEMPO_SEMANA",
"TIEMPO_MES", "DIA_FESTIVO"))
base[is.na(base)] <- 0
accidentes_dia_comuna <- left_join(base, distinct(df[, c("FECHA", "DIA_NOMBRE")]), by = "FECHA")La base de datos con el número de accidentes por comuna, clase y día se obtuvo anteriormente, ésta contiene 175296 observaciones.
## [1] 175296 12
La base luce de la siguiente manera:
Se realiza la partición de los datos para seleccionar el conjunto de entrenamiento y el conjunto de prueba.
test_dia_comuna <- accidentes_dia_comuna[accidentes_dia_comuna$PERIODO == 2018, ]
train_dia_comuna <- accidentes_dia_comuna[accidentes_dia_comuna$PERIODO %in%
c(2014, 2015, 2016, 2017), ]Se procede a la creación de modelos:
Se consideran distintos modelos partiendo de un modelo jerárquico con 2 niveles (CLASE y COMUNA) con solo un intercepto, ambos niveles o variables con efectos aleatorios se consideran correlacionados y se pondrá la variable CLASE (tipo de accidente) dentro de la variable comuna.
mod_dia_comuna0 <- glmer(ACCIDENTALIDAD ~ 1 + (1 | COMUNA/CLASE),
data = train_dia_comuna, family= poisson())
mod_dia_comuna1 <- glmer(ACCIDENTALIDAD ~ DIA_FESTIVO + (1 | COMUNA/CLASE),
data = train_dia_comuna, family= poisson())
mod_dia_comuna2 <- glmer(ACCIDENTALIDAD ~ DIA_FESTIVO + TIEMPO_DIA + (1 | COMUNA/CLASE),
data = train_dia_comuna, family= poisson())
mod_dia_comuna3 <- glmer(ACCIDENTALIDAD ~ DIA_FESTIVO + DIA_NOMBRE + (1 | COMUNA/CLASE),
data = train_dia_comuna, family= poisson())
mod_dia_comuna4 <- glmer(ACCIDENTALIDAD ~ DIA_FESTIVO + DIA_NOMBRE +
(1 + DIA_FESTIVO| COMUNA/CLASE),
data = train_dia_comuna, family= poisson())Se comparan los modelos por un analísis de varianza ANOVA:
Al parecer cada modelo explica mejor la accidentalidad que el anterior, pero se debe recordar que el Valor-P es sensible al número de datos. En la base de entrenamiento hay 140256 observaciones, esto se considera grande, por lo que no hay que fijarse mucho en el Valor-P dado que es más fácil que rechace las hipótesis nulas.
Se procede a calcular el MSE de entrenamiento y de prueba en cada uno de los modelos, cabe resaltar que los valores predichos se redondearán al entero más cercano debido a que son datos de conteo y la función predict devuelve valores en la escala original pero con décimales.
# Modelo 0
y_est_train_dia_comuna0 <- round(predict(mod_dia_comuna0, newdata = train_dia_comuna,
type = "response"),0)
y_est_test_dia_comuna0 <- round(predict(mod_dia_comuna0, newdata = test_dia_comuna,
type = "response"),0)
mse_train_dia_comuna0 <- round(MSE(train_dia_comuna$ACCIDENTALIDAD,
y_est_train_dia_comuna0),4)
mse_test_dia_comuna0 <- round(MSE(test_dia_comuna$ACCIDENTALIDAD,
y_est_test_dia_comuna0),4)
# Modelo 1
y_est_train_dia_comuna1 <- round(predict(mod_dia_comuna1, newdata = train_dia_comuna,
type = "response"),0)
y_est_test_dia_comuna1 <- round(predict(mod_dia_comuna1, newdata = test_dia_comuna,
type = "response"),0)
mse_train_dia_comuna1 <- round(MSE(train_dia_comuna$ACCIDENTALIDAD,
y_est_train_dia_comuna1),4)
mse_test_dia_comuna1 <- round(MSE(test_dia_comuna$ACCIDENTALIDAD,
y_est_test_dia_comuna1),4)
# Modelo 2
y_est_train_dia_comuna2 <- round(predict(mod_dia_comuna2, newdata = train_dia_comuna,
type = "response"),0)
y_est_test_dia_comuna2 <- round(predict(mod_dia_comuna2, newdata = test_dia_comuna,
type = "response"),0)
mse_train_dia_comuna2 <- round(MSE(train_dia_comuna$ACCIDENTALIDAD,
y_est_train_dia_comuna2),4)
mse_test_dia_comuna2 <- round(MSE(test_dia_comuna$ACCIDENTALIDAD,
y_est_test_dia_comuna2),4)
# Modelo 3
y_est_train_dia_comuna3 <- round(predict(mod_dia_comuna3, newdata = train_dia_comuna,
type = "response"),0)
y_est_test_dia_comuna3 <- round(predict(mod_dia_comuna3, newdata = test_dia_comuna,
type = "response"),0)
mse_train_dia_comuna3 <- round(MSE(train_dia_comuna$ACCIDENTALIDAD,
y_est_train_dia_comuna3),4)
mse_test_dia_comuna3 <- round(MSE(test_dia_comuna$ACCIDENTALIDAD,
y_est_test_dia_comuna3),4)
# Modelo 4
y_est_train_dia_comuna4 <- round(predict(mod_dia_comuna4, newdata = train_dia_comuna,
type = "response"),0)
y_est_test_dia_comuna4 <- round(predict(mod_dia_comuna4, newdata = test_dia_comuna,
type = "response"),0)
mse_train_dia_comuna4 <- round(MSE(train_dia_comuna$ACCIDENTALIDAD,
y_est_train_dia_comuna4),4)
mse_test_dia_comuna4 <- round(MSE(test_dia_comuna$ACCIDENTALIDAD,
y_est_test_dia_comuna4),4)| Modelo_Mixto_Poisson | Train_MSE | Test_MSE | Porcentaje_Variacion |
|---|---|---|---|
| ACCIDENTALIDAD ~ 1 + (1 | COMUNA/CLASE) | 2.0222 | 1.9352 | 2.20 |
| ACCIDENTALIDAD ~ DIA_FESTIVO + (1 | COMUNA/CLASE) | 1.9038 | 1.8241 | 2.14 |
| ACCIDENTALIDAD ~ DIA_FESTIVO + TIEMPO_DIA + (1 | COMUNA/CLASE) | 1.9010 | 1.8598 | 1.10 |
| ACCIDENTALIDAD ~ DIA_FESTIVO + DIA_NOMBRE + (1 | COMUNA/CLASE) | 1.5791 | 1.5311 | 1.54 |
| ACCIDENTALIDAD ~ DIA_FESTIVO + DIA_NOMBRE + (1 + DIA_FESTIVO | COMUNA/CLASE) | 1.5400 | 1.5118 | 0.92 |
En los modelos mod_dia_comuna3 y mod_dia_comuna4 se descarta usar la variable TIEMPO_DIA debido a que en lugar en disminuir el Test_MSE, lo aumentó, y tampoco mejoró el Train_MSE significativamente, por lo que se considera que no es significativa para explicar la accidentalidad en las comunas de Medellín por tipo de accidente.
Finalmente se observa que el modelo con intercepto y pendiente aleatoria mod_dia_comuna4:
\[\widehat{\text{ACCIDENTALIDAD}} = \text{DIA_FESTIVO} + \text{DIA_NOMBRE} + (1 + \text{DIA_FESTIVO} | \text{COMUNA/CLASE})\]
Es el que obtiene el menor Train_MSE y Test_MSE, por lo que se escoge este modelo para la explicación de la accidentalidad en comuna por día.
A continuación se muestran algunos de los valores observados de la accidentalidad diaria por clase y por comuna, con su respectivo valor predicho última columna) en el conjunto de prueba.
Para este modelo se agrupa la unidad de tiempo por semanas, en las cuales se suma la cantidad de accidentes que suceden el la misma, también se suma el número de días festivos. La base luce como sigue:
accidentes_semana_comuna <- accidentes_dia_comuna %>%
group_by(COMUNA, CLASE, PERIODO, SEMANA, TIEMPO_SEMANA) %>%
summarise(DIA_FESTIVO = sum(DIA_FESTIVO), ACCIDENTALIDAD = sum(ACCIDENTALIDAD))
accidentes_semana_comunaSe procede a realizar la partición del conjunto de entrenamiento y el conjunto de prueba:
test_semana_comuna <- accidentes_semana_comuna[accidentes_semana_comuna$PERIODO == 2018, ]
train_semana_comuna <- accidentes_semana_comuna[accidentes_semana_comuna$PERIODO %in%
c(2014, 2015, 2016, 2017), ]Ahora se ajustan los modelos mixtos con efectos aleatorios en COMUNA y CLASE al igual que se hizo a nivel diario, es decir, CLASE dentro de COMUNA.
mod_semana_comuna0 <- glmer(ACCIDENTALIDAD ~ 1 + (1 | COMUNA/CLASE),
data = train_semana_comuna, family= poisson())
mod_semana_comuna1 <- glmer(ACCIDENTALIDAD ~ DIA_FESTIVO + (1 | COMUNA/CLASE),
data = train_semana_comuna, family= poisson())
mod_semana_comuna2 <- glmer(ACCIDENTALIDAD ~ DIA_FESTIVO + TIEMPO_SEMANA +
(1 | COMUNA/CLASE),
data = train_semana_comuna, family= poisson())
mod_semana_comuna3 <- glmer(ACCIDENTALIDAD ~ DIA_FESTIVO +
(1 + DIA_FESTIVO | COMUNA/CLASE),
data = train_semana_comuna, family= poisson())Se comparan los modelos por un analísis de varianza ANOVA:
Se tiene el mismo problema del tamaño de muestra que en el modelo diario. Ahora, se procede a calcular el MSE de entrenamiento y de prueba en cada uno de los modelos, cabe resaltar que los valores predichos se redondearán al entero más cercano debido a que son datos de conteo y la función predict devuelve valores en la escala original pero con décimales.
# Modelo 0
y_est_train_semana_comuna0 <- round(predict(mod_semana_comuna0, newdata = train_semana_comuna,
type = "response"),0)
y_est_test_semana_comuna0 <- round(predict(mod_semana_comuna0, newdata = test_semana_comuna,
type = "response"),0)
mse_train_semana_comuna0 <- round(MSE(train_semana_comuna$ACCIDENTALIDAD,
y_est_train_semana_comuna0),4)
mse_test_semana_comuna0 <- round(MSE(test_semana_comuna$ACCIDENTALIDAD,
y_est_test_semana_comuna0),4)
# Modelo 1
y_est_train_semana_comuna1 <- round(predict(mod_semana_comuna1, newdata = train_semana_comuna,
type = "response"),0)
y_est_test_semana_comuna1 <- round(predict(mod_semana_comuna1, newdata = test_semana_comuna,
type = "response"),0)
mse_train_semana_comuna1 <- round(MSE(train_semana_comuna$ACCIDENTALIDAD,
y_est_train_semana_comuna1),4)
mse_test_semana_comuna1 <- round(MSE(test_semana_comuna$ACCIDENTALIDAD,
y_est_test_semana_comuna1),4)
# Modelo 2
y_est_train_semana_comuna2 <- round(predict(mod_semana_comuna2, newdata = train_semana_comuna,
type = "response"),0)
y_est_test_semana_comuna2 <- round(predict(mod_semana_comuna2, newdata = test_semana_comuna,
type = "response"),0)
mse_train_semana_comuna2 <- round(MSE(train_semana_comuna$ACCIDENTALIDAD,
y_est_train_semana_comuna2),4)
mse_test_semana_comuna2 <- round(MSE(test_semana_comuna$ACCIDENTALIDAD,
y_est_test_semana_comuna2),4)
# Modelo 3
y_est_train_semana_comuna3 <- round(predict(mod_semana_comuna3, newdata = train_semana_comuna,
type = "response"),0)
y_est_test_semana_comuna3 <- round(predict(mod_semana_comuna3, newdata = test_semana_comuna,
type = "response"),0)
mse_train_semana_comuna3 <- round(MSE(train_semana_comuna$ACCIDENTALIDAD,
y_est_train_semana_comuna3),4)
mse_test_semana_comuna3 <- round(MSE(test_semana_comuna$ACCIDENTALIDAD,
y_est_test_semana_comuna3),4)| Modelo_Mixto_Poisson | Train_MSE | Test_MSE | Porcentaje_Variacion |
|---|---|---|---|
| ACCIDENTALIDAD ~ 1 + (1 | COMUNA/CLASE) | 16.7066 | 15.1418 | 4.91 |
| ACCIDENTALIDAD ~ DIA_FESTIVO + (1 | COMUNA/CLASE) | 15.0649 | 13.2131 | 6.55 |
| ACCIDENTALIDAD ~ DIA_FESTIVO + TIEMPO_SEMANA + (1 | COMUNA/CLASE) | 14.9353 | 13.7151 | 4.26 |
| ACCIDENTALIDAD ~ DIA_FESTIVO + (1 + DIA_FESTIVO | COMUNA/CLASE) | 14.9111 | 13.1024 | 6.46 |
En el modelo mod_semana_comuna3 se descarta usar la variable TIEMPO_SEMANA debido a que en lugar en disminuir el Test_MSE, lo aumentó, y tampoco mejoró el Train_MSE significativamente, por lo que se considera que no es significativa para explicar la accidentalidad en las comunas de Medellín por tipo de accidente.
Finalmente se observa que el modelo con intercepto y pendiente aleatoria mod_semana_comuna3:
\[\widehat{\text{ACCIDENTALIDAD}} = \text{DIA_FESTIVO} + (1 + \text{DIA_FESTIVO} | \text{COMUNA/CLASE})\]
Es el que obtiene el menor Train_MSE y Test_MSE, por lo que se escoge este modelo para la explicación de la accidentalidad en comuna por semana.
A continuación se muestran algunos de los valores observados de la accidentalidad semanal por clase y por comuna, con su respectivo valor predicho (última columna) en el conjunto de prueba.
Para este modelo se agrupa la unidad de tiempo por meses, en los cuales se suma la cantidad de accidentes que suceden el el mismo, también se suma el número de días festivos que hay en dicho mes. La base luce como sigue:
accidentes_mes_comuna <- accidentes_dia_comuna %>% group_by(COMUNA, CLASE, PERIODO, MES, TIEMPO_MES) %>%
summarise(DIA_FESTIVO = sum(DIA_FESTIVO), ACCIDENTALIDAD = sum(ACCIDENTALIDAD))
accidentes_mes_comunaSe realiza la partición de la base de entrenamiento y de prueba
test_mes_comuna <- accidentes_mes_comuna[accidentes_mes_comuna$PERIODO == 2018, ]
train_mes_comuna <- accidentes_mes_comuna[accidentes_mes_comuna$PERIODO %in%
c(2014, 2015, 2016, 2017), ]Ahora se ajustan los modelos mixtos con efectos aleatorios en COMUNA y CLASE al igual que se hizo a nivel diario y semanal, es decir, CLASE dentro de COMUNA.
mod_mes_comuna0 <- glmer(ACCIDENTALIDAD ~ 1 + (1 | COMUNA/CLASE),
data = train_mes_comuna, family= poisson())
mod_mes_comuna1 <- glmer(ACCIDENTALIDAD ~ DIA_FESTIVO + (1 | COMUNA/CLASE),
data = train_mes_comuna, family= poisson())
mod_mes_comuna2 <- glmer(ACCIDENTALIDAD ~ DIA_FESTIVO + (1 + DIA_FESTIVO | COMUNA/CLASE),
data = train_mes_comuna, family= poisson())Analísis de varianza ANOVA
Se observa que el modelo mod_mes_comuna2, el cual tiene intercepto y pendiente aleatoria con la característica DIA_FESTIVO no aporta significativamente a la explicación de la accidentalidad según el análisis de varianza ANOVA. Sin embargo, se procede a calcular los MSE de entrenamiento y de prueba.
# Modelo 0
y_est_train_mes_comuna0 <- round(predict(mod_mes_comuna0, newdata = train_mes_comuna,
type = "response"),0)
y_est_test_mes_comuna0 <- round(predict(mod_mes_comuna0, newdata = test_mes_comuna,
type = "response"),0)
mse_train_mes_comuna0 <- round(MSE(train_mes_comuna$ACCIDENTALIDAD,
y_est_train_mes_comuna0),4)
mse_test_mes_comuna0 <- round(MSE(test_mes_comuna$ACCIDENTALIDAD,
y_est_test_mes_comuna0),4)
# Modelo 1
y_est_train_mes_comuna1 <- round(predict(mod_mes_comuna1, newdata = train_mes_comuna,
type = "response"),0)
y_est_test_mes_comuna1 <- round(predict(mod_mes_comuna1, newdata = test_mes_comuna,
type = "response"),0)
mse_train_mes_comuna1 <- round(MSE(train_mes_comuna$ACCIDENTALIDAD,
y_est_train_mes_comuna1),4)
mse_test_mes_comuna1 <- round(MSE(test_mes_comuna$ACCIDENTALIDAD,
y_est_test_mes_comuna1),4)
# Modelo 2
y_est_train_mes_comuna2 <- round(predict(mod_mes_comuna2, newdata = train_mes_comuna,
type = "response"),0)
y_est_test_mes_comuna2 <- round(predict(mod_mes_comuna2, newdata = test_mes_comuna,
type = "response"),0)
mse_train_mes_comuna2 <- round(MSE(train_mes_comuna$ACCIDENTALIDAD,
y_est_train_mes_comuna2),4)
mse_test_mes_comuna2 <- round(MSE(test_mes_comuna$ACCIDENTALIDAD,
y_est_test_mes_comuna2),4)| Modelo_Mixto_Poisson | Train_MSE | Test_MSE | Porcentaje_Variacion |
|---|---|---|---|
| ACCIDENTALIDAD ~ 1 + (1 | COMUNA/CLASE) | 88.9306 | 94.6510 | 3.12 |
| ACCIDENTALIDAD ~ DIA_FESTIVO + (1 | COMUNA/CLASE) | 87.6868 | 91.3359 | 2.04 |
| ACCIDENTALIDAD ~ DIA_FESTIVO + (1 + DIA_FESTIVO | COMUNA/CLASE) | 87.6793 | 91.0191 | 1.87 |
Aunque el modelo mod_mes_comuna2 no tiene una mejora muy significativa respecto al modelo mod_mes_comuna1, sigue siendo mejor con el críterio del Test_MSE, por lo que el modelo elegido es el modelo mod_mes_comuna2
\[\widehat{\text{ACCIDENTALIDAD}} = \text{DIA_FESTIVO} + (1 + \text{DIA_FESTIVO} | \text{COMUNA/CLASE})\] A continuación se enseña la comparación entre la accidentalidad observada y la accidentalidad predicha mensualmente para la base de prueba (columna final).
La base de datos para realizar el ajuste de los barrios se obtuvo igual a como se realizó para las comunas, es decir, con un expand.grid pero esta vez agrupando la base de datos por barrios.
Realizando el mismo método visto anteriormente para la selección de modelos en las comunas, se encuentran los siguiente modelos para los barrios.
Base de datos agrupada para la accidentalidad (número de accidentes) diaria.
Conjunto de prueba y conjunto de validación:
test_dia_barrio <- accidentes_dia_barrio[accidentes_dia_barrio$PERIODO == 2018, ]
train_dia_barrio <- accidentes_dia_barrio[accidentes_dia_barrio$PERIODO %in%
c(2014, 2015, 2016, 2017), ]Se encontró que el modelo que mejor explica esta accidentalidad es:
mod_dia_barrio <- glmer(ACCIDENTALIDAD ~ DIA_FESTIVO + (1 | BARRIO/CLASE),
data = train_dia_barrio, family= poisson())## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: poisson ( log )
## Formula: ACCIDENTALIDAD ~ DIA_FESTIVO + (1 | BARRIO/CLASE)
## Data: train_dia_barrio
##
## AIC BIC logLik deviance df.resid
## 858345.4 858396.0 -429168.7 858337.4 2349284
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.401 -0.218 -0.127 -0.042 40.592
##
## Random effects:
## Groups Name Variance Std.Dev.
## CLASE:BARRIO (Intercept) 4.6132 2.1478
## BARRIO (Intercept) 0.1314 0.3625
## Number of obs: 2349288, groups: CLASE:BARRIO, 1608; BARRIO, 268
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -4.30167 0.04902 -87.74 <2e-16 ***
## DIA_FESTIVO -0.55872 0.01404 -39.78 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## DIA_FESTIVO -0.006
Con los siguientes Train_MSE y Test_MSE
# Modelo
y_est_train_dia_barrio <- round(predict(mod_dia_barrio, newdata = train_dia_barrio,
type = "response"),0)
y_est_test_dia_barrio <- round(predict(mod_dia_barrio, newdata = test_dia_barrio,
type = "response"),0)
mse_train_dia_barrio <- round(MSE(train_dia_barrio$ACCIDENTALIDAD,
y_est_train_dia_barrio),4)
mse_test_dia_barrio <- round(MSE(test_dia_barrio$ACCIDENTALIDAD,
y_est_test_dia_barrio),4)| Modelo_Mixto_Poisson | Train_MSE | Test_MSE | Porcentaje_Variacion |
|---|---|---|---|
| ACCIDENTALIDAD ~ DIA_FESTIVO + (1 | BARRIO/CLASE) | 0.0855 | 0.0825 | 1.79 |
Modelo:
\[\widehat{\text{ACCIDENTALIDAD}} = \text{DIA_FESTIVO} + (1 ~|~ \text{COMUNA/CLASE})\]
A continuación se enseña la comparación entre la accidentalidad observada y la accidentalidad predicha diariamente para la base de prueba (columna final).
Base para el modelo semanal
accidentes_semana_barrio <- accidentes_dia_barrio %>% group_by(BARRIO, CLASE, PERIODO, SEMANA, TIEMPO_SEMANA) %>%
summarise(DIA_FESTIVO = sum(DIA_FESTIVO), ACCIDENTALIDAD = sum(ACCIDENTALIDAD))Conjunto de prueba y conjunto de validación:
test_semana_barrio <- accidentes_semana_barrio[accidentes_semana_barrio$PERIODO == 2018, ]
train_semana_barrio <- accidentes_semana_barrio[accidentes_semana_barrio$PERIODO %in% c(2014, 2015, 2016, 2017), ]Se encontró que el modelo que mejor explica esta accidentalidad es:
mod_semana_barrio <- glmer(ACCIDENTALIDAD ~ DIA_FESTIVO + (1 | BARRIO/CLASE),
data = train_semana_barrio, family= poisson())## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: poisson ( log )
## Formula: ACCIDENTALIDAD ~ DIA_FESTIVO + (1 | BARRIO/CLASE)
## Data: train_semana_barrio
##
## AIC BIC logLik deviance df.resid
## 393085.5 393128.5 -196538.8 393077.5 337676
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.4675 -0.4319 -0.2232 -0.0580 14.6509
##
## Random effects:
## Groups Name Variance Std.Dev.
## CLASE:BARRIO (Intercept) 4.6131 2.1478
## BARRIO (Intercept) 0.1314 0.3625
## Number of obs: 337680, groups: CLASE:BARRIO, 1608; BARRIO, 268
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.350538 0.058605 -40.11 <2e-16 ***
## DIA_FESTIVO -0.097847 0.004276 -22.89 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## DIA_FESTIVO -0.023
# Modelo
y_est_train_semana_barrio <- round(predict(mod_semana_barrio, newdata = train_semana_barrio,
type = "response"),0)
y_est_test_semana_barrio <- round(predict(mod_semana_barrio, newdata = test_semana_barrio,
type = "response"),0)
mse_train_semana_barrio <- round(MSE(train_semana_barrio$ACCIDENTALIDAD,
y_est_train_semana_barrio),4)
mse_test_semana_barrio <- round(MSE(test_semana_barrio$ACCIDENTALIDAD,
y_est_test_semana_barrio),4)| Modelo_Mixto_Poisson | Train_MSE | Test_MSE | Porcentaje_Variacion |
|---|---|---|---|
| ACCIDENTALIDAD ~ DIA_FESTIVO + (1 | BARRIO/CLASE) | 0.5967 | 0.6149 | 1.5 |
Modelo:
\[\widehat{\text{ACCIDENTALIDAD}} = \text{DIA_FESTIVO} + (1 ~|~ \text{COMUNA/CLASE})\]
A continuación se enseña la comparación entre la accidentalidad observada y la accidentalidad predicha semanalmente para la base de prueba (columna final).
Base para el modelo mensual
accidentes_mes_barrio <- accidentes_dia_barrio %>% group_by(BARRIO, CLASE, PERIODO, MES, TIEMPO_MES) %>%
summarise(DIA_FESTIVO = sum(DIA_FESTIVO), ACCIDENTALIDAD = sum(ACCIDENTALIDAD))Conjunto de prueba y conjunto de validación:
test_mes_barrio <- accidentes_mes_barrio[accidentes_mes_barrio$PERIODO == 2018, ]
train_mes_barrio <- accidentes_mes_barrio[accidentes_mes_barrio$PERIODO %in% c(2014, 2015, 2016, 2017), ]Se encontró que el modelo que mejor explica esta accidentalidad es:
mod_mes_barrio <- glmer(ACCIDENTALIDAD ~ DIA_FESTIVO + (1 | BARRIO/CLASE),
data = train_mes_barrio, family= poisson())## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: poisson ( log )
## Formula: ACCIDENTALIDAD ~ DIA_FESTIVO + (1 | BARRIO/CLASE)
## Data: train_mes_barrio
##
## AIC BIC logLik deviance df.resid
## 178242.8 178279.8 -89117.4 178234.8 77180
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.9616 -0.5902 -0.1680 0.3015 9.4194
##
## Random effects:
## Groups Name Variance Std.Dev.
## CLASE:BARRIO (Intercept) 4.6131 2.1478
## BARRIO (Intercept) 0.1314 0.3625
## Number of obs: 77184, groups: CLASE:BARRIO, 1608; BARRIO, 268
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.888590 0.059602 -14.909 < 2e-16 ***
## DIA_FESTIVO -0.012645 0.002292 -5.516 3.46e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## DIA_FESTIVO -0.061
# Modelo
y_est_train_mes_barrio <- round(predict(mod_mes_barrio, newdata = train_mes_barrio,
type = "response"),0)
y_est_test_mes_barrio <- round(predict(mod_mes_barrio, newdata = test_mes_barrio,
type = "response"),0)
mse_train_mes_barrio <- round(MSE(train_mes_barrio$ACCIDENTALIDAD,
y_est_train_mes_barrio),4)
mse_test_mes_barrio <- round(MSE(test_mes_barrio$ACCIDENTALIDAD,
y_est_test_mes_barrio),4)| Modelo_Mixto_Poisson | Train_MSE | Test_MSE | Porcentaje_Variacion |
|---|---|---|---|
| ACCIDENTALIDAD ~ DIA_FESTIVO + (1 | BARRIO/CLASE) | 2.8034 | 3.6059 | 12.52 |
Modelo:
\[\widehat{\text{ACCIDENTALIDAD}} = \text{DIA_FESTIVO} + (1 ~|~ \text{COMUNA/CLASE})\]
A continuación se enseña la comparación entre la accidentalidad observada y la accidentalidad predicha mensualmente para la base de prueba (columna final).